home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-vm.el.z / efs-vm.el
Encoding:
Text File  |  1998-05-21  |  12.4 KB  |  343 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-vm.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  Allows the VM  mail reader to access folders using efs.
  9. ;;               If you are looking for support for VM/CMS, see efs-cms.el.
  10. ;; Author:       Sandy Rutherford <sandy@ibm550.sissa.it>
  11. ;; Created:      Mon Nov  9 23:49:18 1992 by sandy on riemann
  12. ;; Modified:     Sun Nov 27 18:44:07 1994 by sandy on gandalf
  13. ;; 
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;; If vm-get-new-mail (usually bound to "g") is given a prefix, it
  17. ;; will prompt for a folder from which to collect mail. With
  18. ;; efs-vm, this folder can be in efs syntax. As is usual
  19. ;; with VM, this folder will not be deleted. If at the folder prompt,
  20. ;; you give "/user@host:", efs-vm will collect mail from the
  21. ;; spool file on the remote machine. The spool file will be deleted if
  22. ;; the mail is successfully collected. It is not necessary for
  23. ;; movemail, nor even emacs, to be installed on the remote machine.
  24. ;; The functionality of movemail is mimicked with FTP commands. Both
  25. ;; local and remote crashboxes are used, so that mail will not be lost
  26. ;; if the FTP connection is lost.
  27. ;;
  28. ;; To use efs-vm, put (require 'efs-vm) in your .vm file.
  29. ;;
  30. ;; Works for vm 5.56 through 5.72.  May not work with older versions.
  31. ;; If vm grows some file-name-handler-alist support, we should use it.
  32. ;; Actually it has.  I just haven't gotten around to this yet.
  33.  
  34. ;;; Known Bugs:
  35. ;;
  36. ;;  1. efs-vm will not be able to collect mail from a spool file if
  37. ;;     you do not have write permission in the spool directory.
  38. ;;     I think that this precludes HP-UX.
  39. ;;     I hope to do something about this.
  40. ;;
  41. ;;  2. efs-vm is as clever as at can be about spool file locking.
  42. ;;     i.e. not very clever at all.  At least it uses a rename command
  43. ;;     to minimize the window for problems.  Use POP if you want to
  44. ;;     be careful.
  45. ;;
  46.  
  47. ;;; Provisions, requirements, and autoloads
  48.  
  49. (provide 'efs-vm)
  50. (require 'efs-cu)
  51. (require 'efs-ovwrt)
  52. (require 'vm)
  53. ;(require 'vm-folder) ; not provided
  54. (if (or (not (fboundp 'vm-get-new-mail))
  55.     (eq (car-safe (symbol-function 'vm-get-new-mail)) 'autoload))
  56.     (load-library "vm-folder"))
  57. (autoload 'efs-make-tmp-name "efs")
  58. (autoload 'efs-del-tmp-name "efs")
  59. (autoload 'efs-send-cmd "efs")
  60. (autoload 'efs-re-read-dir "efs")
  61. (autoload 'efs-copy-file-internal "efs")
  62.  
  63. ;;; User variables
  64.  
  65. (defvar efs-vm-spool-files nil
  66.   "Association list of \( USER@MACHINE . SPOOLFILES \) pairs that
  67. specify the location of the default remote spool file for MACHINE. SPOOLFILES
  68. is a list of remote spool files.")
  69.  
  70. (defvar efs-vm-crash-box "~/EFS.INBOX.CRASH"
  71.   "Local file where efs keeps its local crash boxes.")
  72.  
  73. ;;; Internal variables
  74.  
  75. (defconst efs-vm-version
  76.   (concat (substring "$efs release: 1.15 $" 14 -2)
  77.       "/"
  78.       (substring "#Revision: 1.1 $" 11 -2)))
  79.  
  80.  
  81. (defun efs-vm-get-new-mail (&optional arg)
  82.   "Documented as original"
  83.   (interactive "P")
  84.   (vm-select-folder-buffer)
  85.   (vm-check-for-killed-summary)
  86.   (vm-error-if-virtual-folder)
  87.   (vm-error-if-folder-read-only)
  88.   (cond
  89.    ((null arg)
  90.     (if (not (eq major-mode 'vm-mode))
  91.     (vm-mode))
  92.     (if (consp (car (vm-spool-files)))
  93.     (message "Checking for new mail for %s..." buffer-file-name)
  94.       (message "Checking for new mail..."))
  95.     (let (new-messages totals-blurb)
  96.       (if (and (vm-get-spooled-mail)
  97.            (setq new-messages (vm-assimilate-new-messages t)))
  98.       (progn
  99.         (if vm-arrived-message-hook
  100.         (while new-messages
  101.           (vm-run-message-hook (car new-messages)
  102.                        'vm-arrived-message-hook)
  103.           (setq new-messages (cdr new-messages))))
  104.         ;; say this NOW, before the non-previewers read
  105.         ;; a message, alter the new message count and
  106.         ;; confuse themselves.
  107.         (setq totals-blurb (vm-emit-totals-blurb))
  108.         (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
  109.         (if (vm-thoughtfully-select-message)
  110.         (vm-preview-current-message)
  111.           (vm-update-summary-and-mode-line))
  112.         (message totals-blurb))
  113.     (if (consp (car (vm-spool-files)))
  114.         (message "No new mail for %s" buffer-file-name)
  115.       (message "No new mail."))
  116.     (sit-for 4)
  117.     (message ""))))
  118.    (t
  119.     (let* ((buffer-read-only nil)
  120.        (folder (read-file-name "Gather mail from folder: "
  121.                    vm-folder-directory t))
  122.        (parsed (efs-ftp-path folder))
  123.        mcount new-messages totals-blurb)
  124.       (if parsed
  125.       (if (string-equal (nth 2 parsed) "")
  126.           ;; a spool file
  127.           (if (not (and (efs-vm-get-remote-spooled-mail folder)
  128.                 (setq new-messages
  129.                   (vm-assimilate-new-messages t))))
  130.           (progn
  131.             (message
  132.              "No new mail, or mail couldn't be retrieved by ftp.")
  133.             ;; don't let this message stay up forever...
  134.             (sit-for 4)
  135.             (message ""))
  136.         (if vm-arrived-message-hook
  137.             (while new-messages
  138.               (vm-run-message-hook (car new-messages)
  139.                        'vm-arrived-message-hook)
  140.               (setq new-messages (cdr new-messages))))
  141.         ;; say this NOW, before the non-previewers read
  142.         ;; a message, alter the new message count and
  143.         ;; confuse themselves.
  144.         (setq totals-blurb (vm-emit-totals-blurb))
  145.         (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
  146.         (if (vm-thoughtfully-select-message)
  147.             (vm-preview-current-message)
  148.           (vm-update-summary-and-mode-line))
  149.         (message totals-blurb))
  150.         
  151.         ;; a remote folder
  152.         (let ((tmp-file (car (efs-make-tmp-name nil (car parsed))))
  153.           (folder (expand-file-name folder)))
  154.           (unwind-protect
  155.           (progn
  156.             (efs-copy-file-internal
  157.              folder parsed tmp-file nil t nil
  158.              (format "Getting %s" folder)
  159.              ;; asynch worries me here
  160.              nil nil)
  161.             (if (and vm-check-folder-types
  162.                  (not (vm-compatible-folder-p tmp-file)))
  163.             (error
  164.              "Folder %s is not the same format as this folder."
  165.              folder))
  166.             (save-excursion
  167.               (vm-save-restriction
  168.                (widen)
  169.                (goto-char (point-max))
  170.                (insert-file-contents tmp-file)))
  171.             (setq mcount (length vm-message-list))
  172.             (if (setq new-messages (vm-assimilate-new-messages))
  173.             (progn
  174.               (if vm-arrived-message-hook
  175.                   (while new-messages
  176.                 (vm-run-message-hook (car new-messages)
  177.                              'vm-arrived-message-hook)
  178.                 (setq new-messages (cdr new-messages))))
  179.               ;; say this NOW, before the non-previewers read
  180.               ;; a message, alter the new message count and
  181.               ;; confuse themselves.
  182.               (setq totals-blurb (vm-emit-totals-blurb))
  183.               (vm-display nil nil '(vm-get-new-mail)
  184.                       '(vm-get-new-mail))
  185.               (if (vm-thoughtfully-select-message)
  186.                   (vm-preview-current-message)
  187.                 (vm-update-summary-and-mode-line))
  188.               (message totals-blurb)
  189.               ;; The gathered messages are actually still on disk
  190.               ;; unless the user deletes the folder himself.
  191.               ;; However, users may not understand what happened if
  192.               ;; the messages go away after a "quit, no save".
  193.               (setq vm-messages-not-on-disk
  194.                 (+ vm-messages-not-on-disk
  195.                    (- (length vm-message-list)
  196.                       mcount))))
  197.               (message "No messages gathered."))
  198.             (efs-del-tmp-name tmp-file)))))
  199.  
  200.     ;; local
  201.     
  202.     (if (and vm-check-folder-types
  203.          (not (vm-compatible-folder-p folder)))
  204.         (error "Folder %s is not the same format as this folder."
  205.            folder))
  206.     (save-excursion
  207.       (vm-save-restriction
  208.        (widen)
  209.        (goto-char (point-max))
  210.        (insert-file-contents folder)))
  211.     (setq mcount (length vm-message-list))
  212.     (if (setq new-messages (vm-assimilate-new-messages))
  213.         (progn
  214.           (if vm-arrived-message-hook
  215.           (while new-messages
  216.                (vm-run-message-hook (car new-messages)
  217.                         'vm-arrived-message-hook)
  218.                (setq new-messages (cdr new-messages))))
  219.           ;; say this NOW, before the non-previewers read
  220.           ;; a message, alter the new message count and
  221.           ;; confuse themselves.
  222.           (setq totals-blurb (vm-emit-totals-blurb))
  223.           (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail))
  224.           (if (vm-thoughtfully-select-message)
  225.           (vm-preview-current-message)
  226.         (vm-update-summary-and-mode-line))
  227.           (message totals-blurb)
  228.           ;; The gathered messages are actually still on disk
  229.           ;; unless the user deletes the folder himself.
  230.           ;; However, users may not understand what happened if
  231.           ;; the messages go away after a "quit, no save".
  232.           (setq vm-messages-not-on-disk
  233.                (+ vm-messages-not-on-disk
  234.               (- (length vm-message-list)
  235.                  mcount))))
  236.       (message "No messages gathered.")))))))
  237.  
  238. (defun efs-vm-gobble-remote-crash-box (remote-crash-box)
  239.   (let ((remote-crash-box (expand-file-name remote-crash-box))
  240.     (crash-box (expand-file-name efs-vm-crash-box))
  241.     lsize)
  242.     (if (file-exists-p vm-crash-box)
  243.     (progn
  244.       ;; This should never happen, but let's make sure that we never
  245.       ;; clobber mail.
  246.       (message "Recovering messages from local crash box...")
  247.       (vm-gobble-crash-box efs-vm-crash-box)
  248.       (message "Recovering messages from local crash box... done")))
  249.     (efs-copy-file-internal remote-crash-box (efs-ftp-path remote-crash-box)
  250.                 crash-box nil nil nil
  251.                 (format "Getting %s" remote-crash-box)
  252.                 ;; asynch worries me here
  253.                 nil nil)
  254.     ;; only delete the remote crash box if we are sure that we have everything
  255.     (if (and (setq lsize (nth 7 (file-attributes crash-box)))
  256.          (eq lsize (nth 7 (file-attributes remote-crash-box)))
  257.          (vm-compatible-folder-p crash-box))
  258.     (progn
  259.       (vm-gobble-crash-box crash-box)
  260.       (delete-file remote-crash-box))
  261.       ;; don't leave garbage in the local crash box
  262.       (condition-case () (delete-file crash-box) (error nil))
  263.       (error "Problem reading remote crash box %s" remote-crash-box))))
  264.  
  265. (defun efs-vm-get-remote-spooled-mail (remote-path)
  266.   ;; remote-path is usually of the form /user@machine:
  267.   ;; Usually vm sets inhibit-quit to t for this. This is probably
  268.   ;; a bad idea if there is ftp activity.
  269.   ;; I don't want to assume that the remote machine has movemail.
  270.   ;; Try to mimic movemail with ftp commands as best as possible.
  271.   ;; For this to work, we need to be able to create a subdirectory
  272.   ;; in the spool directory.
  273.   (if vm-block-new-mail
  274.     (error "Can't get new mail until you save this folder."))
  275.   (let* ((parsed (efs-ftp-path remote-path))
  276.      (host (car parsed))
  277.      (user (nth 1 parsed))
  278.      (spool-files
  279.       (or (cdr (assoc (concat user "@" host)
  280.               efs-vm-spool-files))
  281.           (list (concat "/usr/spool/mail/" user))))
  282.      got-mail)
  283.     (while spool-files
  284.       (let* ((s-file (car spool-files))
  285.          (spool-file (format efs-path-format-string user host s-file))
  286.          ;; rmdir and mkdir bomb if this path ends in a /.
  287.          (c-dir (concat s-file ".CRASHBOX"))
  288.          (rc-file (concat c-dir "/CRASHBOX"))
  289.          (crash-dir (concat spool-file ".CRASHBOX/"))
  290.          (remote-crash-file (concat crash-dir "CRASHBOX"))
  291.          (crash-box (expand-file-name efs-vm-crash-box)))
  292.     (if (file-exists-p crash-box)
  293.         (progn
  294.           (message "Recovering messages from crash box...")
  295.           (vm-gobble-crash-box crash-box)
  296.          (message "Recovering messages from crash box... done")
  297.          (setq got-mail t)))
  298.     (if (let ((efs-allow-child-lookup nil))
  299.           (file-exists-p remote-crash-file))
  300.         (progn
  301.           (message "Recovering messages from remote crash box...")
  302.         (efs-vm-gobble-remote-crash-box remote-crash-file)
  303.         (message "Recovering messages from remote crash box... done")
  304.         (setq got-mail t)))
  305.     (if (file-exists-p crash-box)
  306.         (progn
  307.           (message "Recovering messages from crash box...")
  308.           (vm-gobble-crash-box crash-box)
  309.           (message "Recovering messages from crash box... done")
  310.           (setq got-mail t)))
  311.     (unwind-protect
  312.         (if (car
  313.          (efs-send-cmd
  314.           host user (list 'mkdir c-dir)
  315.           (format "Making crash directory %s" crash-dir)))
  316.         (progn
  317.           (efs-re-read-dir crash-dir)
  318.           (message "Unable to make crash directory %s" crash-dir)
  319.           (ding))
  320.           (or (car
  321.            (efs-send-cmd host user (list 'rename s-file rc-file)
  322.                  (format "Checking spool file %s" spool-file)))
  323.           (progn
  324.             (message "Getting new mail from %s..." spool-file)
  325.             ;; The rename above wouldn't have updated the cash.
  326.             (efs-re-read-dir crash-dir)
  327.             (efs-vm-gobble-remote-crash-box remote-crash-file)
  328.             (message "Getting new mail from %s... done" spool-file)
  329.             (setq got-mail t))))
  330.       (condition-case nil
  331.           (efs-send-cmd
  332.            host user (list 'rmdir c-dir)
  333.            "Removing crash directory")
  334.         (error nil))))
  335.       (setq spool-files (cdr spool-files)))
  336.     got-mail))
  337.  
  338. ;;; Overwrite existing functions
  339.  
  340. (efs-overwrite-fn "efs" 'vm-get-new-mail)
  341.  
  342. ;;; end of efs-vm.el
  343.